home *** CD-ROM | disk | FTP | other *** search
/ The Utilities Experience / The Utilities Experience - Volume 1.iso / software / graphics / n-z / playkiss / src / ppmtocel.e < prev   
Text File  |  1995-12-21  |  5KB  |  179 lines
  1.  
  2. MODULE 'dos/dos'
  3.  
  4. CONST FILE_MARK_CELL=$20,FILE_MARK_PALET=$10
  5. DEF rdarg
  6. DEF argarray[21]:LIST
  7. DEF source[250]:STRING
  8. DEF dest[250]:STRING
  9. DEF palette[250]:STRING
  10. DEF dummy[250]:STRING
  11. DEF fh1,fh2,fh3,res,i,t,offset
  12. DEF re[18]:LIST,gr[18]:LIST,bl[18]:LIST
  13. DEF red,grn,blu
  14. DEF buffer
  15. DEF x,y,w,h,nw
  16. DEF long
  17. DEF r1,g1,b1,r2,g2,b2
  18. DEF res1,res2
  19. DEF xoff=0,yoff=0,oldmode=FALSE
  20. RAISE "^C" IF CtrlC ()=TRUE
  21.  
  22. PROC ibmconv(a)
  23.     DEF hi,lo,ret
  24.     hi:=a AND $FF00
  25.     lo:=a AND $00FF
  26.     ret:=Shl(lo,8) OR Shr(hi,8)
  27. ENDPROC ret
  28.  
  29. PROC readstring(fh,buf)
  30.     DEF ret=0,bp=0
  31.  
  32.     PutLong(buf,0)
  33.     PutLong(buf+4,0)
  34.     Read(fh,buf+bp,1);bp:=bp+1
  35.     WHILE (iswhitespace(Char(buf+bp-1))=0)
  36.         Read(fh,buf+bp,1);bp:=bp+1
  37.         CtrlC()
  38.     ENDWHILE
  39.     PutChar(buf+bp-1,0)
  40.     StrToLong(buf,{ret})
  41. ENDPROC ret
  42.  
  43. PROC iswhitespace(a)
  44.     IF a=10 THEN RETURN TRUE
  45.     IF a=9 THEN RETURN TRUE
  46.     IF a=13 THEN RETURN TRUE
  47.     IF a=32 THEN RETURN TRUE
  48.     IF a="," THEN RETURN TRUE
  49. ENDPROC FALSE
  50.  
  51. PROC main() HANDLE
  52.     buffer:=New(10000)
  53.     argarray[0]:=0
  54.     argarray[1]:=0
  55.     argarray[2]:=0
  56.     argarray[3]:=0
  57.     argarray[4]:=0
  58.     argarray[5]:=0
  59.     rdarg:=ReadArgs('FROM/A,TO,MAP/A,X/N,Y/N,OLD/S',argarray,0)
  60.  
  61.     IF argarray[0]<>NIL
  62.         StrCopy(source,argarray[0],ALL)
  63.     ELSE
  64.         Raise("HELP")
  65.     ENDIF
  66.     IF argarray[1]<>NIL
  67.         StrCopy(dest,argarray[1],ALL)
  68.         IF StrLen(dest)<1
  69.             StrCopy(dest,source,ALL)
  70.             i:=InStr(UpperStr(dest),'.PPM')
  71.             StrCopy(dest,source,i)
  72.             StrAdd(dest,'.CEL',ALL)
  73.         ENDIF
  74.     ELSE
  75.         StrCopy(dest,source,ALL)
  76.         i:=InStr(UpperStr(dest),'.PPM')
  77.         StrCopy(dest,source,i)
  78.         StrAdd(dest,'.CEL',ALL)
  79.     ENDIF
  80.     IF argarray[2]<>NIL
  81.         StrCopy(palette,argarray[2],ALL)
  82.     ELSE
  83.         Raise("HELP")
  84.     ENDIF
  85.     IF argarray[3]<>NIL THEN xoff:=argarray[3];xoff:=^xoff
  86.     IF argarray[4]<>NIL    THEN yoff:=argarray[4];yoff:=^yoff
  87.     IF argarray[5]<>NIL THEN oldmode:=TRUE
  88.     IF (rdarg<>0)
  89. WriteF('Translating "\s" to "\s"...\n',source,dest)
  90.         IF (fh3:=Open(palette,MODE_OLDFILE))
  91.             Read(fh3,buffer,60)
  92.             IF Int(buffer)<>"P6" THEN Raise("NOP6")
  93.             t:=0
  94.             FOR i:=2 TO 59
  95.                 IF ((Char(buffer+i)=10) OR (Char(buffer+i)=32) OR (Char(buffer+i)=13) OR (Char(buffer+i)=9)) THEN t:=t+1
  96.         IF (t=4)
  97.                     offset:=i+1;t:=5
  98.                 ENDIF
  99.       ENDFOR
  100.             FOR i:=0 TO 15
  101.         red:=(Char(buffer+offset+(i*3)) AND $F0)
  102.         grn:=(Char(buffer+offset+(i*3)+1) AND $F0)
  103.         blu:=(Char(buffer+offset+(i*3)+2) AND $F0)
  104.         re[i]:=red;gr[i]:=grn;bl[i]:=blu
  105.       ENDFOR
  106.             IF (fh1:=Open(source,MODE_OLDFILE))
  107.                 IF (fh2:=Open(dest,MODE_NEWFILE))
  108.                     Read(fh1,buffer,3)
  109.                     IF Int(buffer)<>"P6" THEN Raise("NOP5")
  110.                     w:=readstring(fh1,buffer)
  111.                     h:=readstring(fh1,buffer)
  112.                     i:=readstring(fh1,buffer)
  113.  
  114.                     nw:=Shl(Shr(w+1,1),1)
  115.  
  116. WriteF('Source image size= \d x \d x \d \n',w,h,i)
  117.  
  118.                     IF oldmode=TRUE
  119.                         PutInt(buffer,ibmconv(nw))
  120.                         PutInt(buffer+2,ibmconv(h))
  121.                         Write(fh2,buffer,4)
  122.                     ELSE
  123.                         PutLong(buffer,"KiSS")
  124.                         PutChar(buffer+4,FILE_MARK_CELL)
  125.                         PutChar(buffer+5,4)
  126.                         PutInt(buffer+8,ibmconv(nw))
  127.                         PutInt(buffer+10,ibmconv(h))
  128.                         PutInt(buffer+12,ibmconv(xoff))
  129.                         PutInt(buffer+14,ibmconv(yoff))
  130.                         Write(fh2,buffer,32)
  131.                     ENDIF
  132.  
  133.                     FOR y:=0 TO h-1
  134.                         res:=Read(fh1,buffer,w*3)
  135.                         IF (res<0) THEN Raise("DOS")
  136.                         CtrlC()
  137.                         FOR x:=0 TO w-1 STEP 2
  138.                             r1:=(Char(buffer+(x*3)) AND $F0)
  139.                             g1:=(Char(buffer+(x*3)+1) AND $F0)
  140.                             b1:=(Char(buffer+(x*3)+2) AND $F0)
  141.                             r2:=(Char(buffer+(x*3)+3) AND $F0)
  142.                             g2:=(Char(buffer+(x*3)+4) AND $F0)
  143.                             b2:=(Char(buffer+(x*3)+5) AND $F0)
  144.  
  145.                             res1:=-1;res2:=-1
  146.                             FOR i:=0 TO 15
  147.                                 IF ((r1=re[i]) AND (g1=gr[i]) AND (b1=bl[i])) THEN res1:=i
  148.                                 IF ((r2=re[i]) AND (g2=gr[i]) AND (b2=bl[i])) THEN res2:=i
  149.                             ENDFOR
  150.                             IF ((res1<0) OR (res2<0)) THEN Raise("PAL")
  151.                             PutChar(buffer+(x/2),(Shl((res1 AND $F),4) OR (res2 AND $F)))
  152.                         ENDFOR
  153.                         Write(fh2,buffer,(w/2))
  154.                     ENDFOR
  155.                 ELSE
  156.                     Raise("DOS")
  157.                 ENDIF
  158.             ELSE
  159.                 Raise("DOS")
  160.             ENDIF
  161.         ELSE
  162.             Raise("DOS")
  163.         ENDIF
  164.     ELSE
  165.         Raise("NONE")
  166.     ENDIF
  167. EXCEPT DO
  168.     IF fh1 THEN Close(fh1)
  169.     IF fh2 THEN Close(fh2)
  170.     IF fh3 THEN Close(fh3)
  171.     IF buffer THEN Dispose(buffer)
  172.     IF exception="HELP" THEN WriteF('Usage: ppmtocel FROM\\A,TO,MAP\\A\n\n')
  173.     IF exception="DOS" THEN WriteF('An error occured.\n\n')
  174.     IF exception="PAL" THEN WriteF('Colors do not match.  Use "ppmquant -map".\n\n')
  175.     IF exception="P6P6" THEN WriteF('Map file contains more than 16 colors.\n\n')
  176.     IF exception="NOP6" THEN WriteF('Map file is invalid.\n\n')
  177.     IF exception="NOP5" THEN WriteF('Source file is invalid.\n\n')
  178. ENDPROC
  179.